' Listing 2 - Concen.Frm Const MAX_MATCH = 20 Dim CrLf As String Dim PiecesLoaded As Integer Dim CurrentPlayer As Integer Dim NumShown As Integer Dim Piece1 As Integer Dim Piece2 As Integer Dim PlayingGame As Integer Dim MatchesMade As Integer Sub NewCmd_Click () ReDim TrackUsed(1 To 20) As Integer Dim Selection As Integer, PicSelected As Integer Dim i As Integer ' Initialize game variables InitPlayerRecs MousePointer = HOURGLASS ' Load the game pieces if not already done. If Not PiecesLoaded% Then For i% = 1 To 39 Load btnGamePiece(i%) InitGamePiece btnGamePiece(i%) Next i% PiecesLoaded% = TRUE End If Piece1% = -1 Piece2% = -1 MatchesMade% = 0 PlayingGame = TRUE ' Shuffle the pieces Randomize Timer For i% = 0 To 39 PicSelected% = FALSE Do Selection% = Int(Rnd(1) * 20) + 1 If TrackUsed(Selection%) < 2 Then PicSelected% = TRUE TrackUsed(Selection%) = TrackUsed(Selection%) + 1 SetPic btnGamePiece(i%), Selection% End If Loop Until PicSelected% Next i% MousePointer = DEFAULT MsgBox "Ready to start game.", MB_ICONINFORMATION, "New Game" End Sub Sub ExitCmd_Click () End End Sub Sub Form_Load () CrLf$ = Chr$(13) + Chr$(10) ' Initialize CrLf$ End Sub Sub btnGamePiece_Click (Index As Integer) Dim NewScore As Integer If Index = Piece1% Then btnGamePiece(Index).Frame = 2 btnGamePiece(Index).Value = 2 Exit Sub End If NumShown% = NumShown% + 1 If PlayingGame Then Select Case NumShown% Case 1 Piece1% = Index Case 2 Piece2% = Index If btnGamePiece(Piece1%).Tag = btnGamePiece(Piece2%).Tag Then MessageBeep (MB_ICONINFORMATION) MsgBox "You made a match!", MB_ICONINFORMATION, "A Match!" btnGamePiece(Piece1%).Visible = FALSE btnGamePiece(Piece2%).Visible = FALSE NumShown% = 0 Piece1% = -1 Piece2% = -1 NewScore% = Players(CurrentPlayer).Score NewScore% = NewScore% + 1 Players(CurrentPlayer).Score = NewScore% PlayerScore(CurrentPlayer - 1).Caption = Str$(NewScore%) MatchesMade% = MatchesMade% + 1 Else Timer1.Interval = 3000 / Players(CurrentPlayer).Level Timer1.Enabled = TRUE End If Case 3 btnGamePiece(Index).Value = 1 btnGamePiece(Index).Frame = 1 NumShown% = 2 End Select Else MsgBox "Start a new game first!", MB_ICONEXCLAMATION, "Error" End If If MatchesMade% >= MAX_MATCH Then AnnounceWinner End If End Sub Sub Timer1_Timer () btnGamePiece(Piece1%).Value = 1 btnGamePiece(Piece2%).Value = 1 NumShown% = 0 Piece1% = -1 Piece2% = -1 Timer1.Enabled = FALSE If CurrentPlayer = 1 Then PlayerName(0).BackColor = QBColor(15) PlayerName(1).BackColor = QBColor(7) CurrentPlayer = 2 Else PlayerName(1).BackColor = QBColor(15) PlayerName(0).BackColor = QBColor(7) CurrentPlayer = 1 End If End Sub Sub AnnounceWinner () Dim Msg As String, Title As String If Players(1).Score > Players(2).Score Then Msg$ = Players(1).Name + " is the winner!" Title$ = "Congratulations!" ElseIf Players(1).Score < Players(2).Score Then Msg$ = Players(2).Name + " is the winner!" Title$ = "Congratulations!" Else Msg$ = "The game was tied!" Title$ = "No Winner" End If MsgBox Msg$, MB_ICONEXCLAMATION, Title$ PlayingGame = FALSE End Sub Sub InitPlayerRecs () Dim i As Integer For i% = 1 To 2 Players(i%).Level = 1 Next i% PlayerInfoForm.Show MODAL Unload PlayerInfoForm CurrentPlayer = 1 For i% = 1 To 2 PlayerName(i% - 1).Caption = Players(i%).Name Next i% PlayerName(CurrentPlayer - 1).BackColor = QBColor(7) End Sub Sub SetPic (PicBox As Control, PicNum As Integer) PicBox.Frame = 2 PicSet.Frame = PicNum% PicBox.Picture = PicSet.Picture PicBox.Tag = Str$(PicNum%) PicBox.Frame = 1 PicBox.Value = 1 PicBox.Enabled = TRUE PicBox.Visible = TRUE End Sub Sub InitGamePiece (Piece As Control) Static X, Y ' Make sure x and y are only initialized the ' first time the Sub gets called. If X = 0 Then X = 720 Y = 120 End If Piece.Left = X Piece.Top = Y ' Piece.Picture = Source.Picture X = X + 600 If X > 5520 Then X = 120 Y = Y + 600 End If End Sub Sub AboutCmd_Click () AboutBox.Show MODAL Unload AboutBox End Sub Sub Form_Unload (Cancel As Integer) For i% = 1 To 39 Unload btnGamePiece(i%) Next i% End Sub